;; A simple database, designed to be cool and very inefficient.

(require :cells)

(defpackage :cells-db
  (:use :cl :cells))

(in-package :cells-db)

(defmodel person (family)
  ((first-name :cell t
	       :initarg :first-name
	       :accessor first-name
	       :initform (cv nil))
   (last-name :cell t
	      :initarg :last-name
	      :accessor last-name
	      :initform (cv nil))
   (full-name :cell t
	      :accessor full-name
	      :initform (c? (concatenate 'string
					 (^first-name)
					 " "
					 (^last-name))))
   (gender :cell t
	   :initarg :gender
	   :accessor gender
	   :initform (cv 'indeterminate))
   (friends :cell t
	    :initarg :friends
	    :accessor friends
	    :initform (cv nil)))
  (:documentation "A person with a last name, first name, and a list of
                   friends."))

(defmethod female ((self person))
  (eq (gender self) 'female))

(defmethod male ((self person))
  (eq (gender self) 'male))

(defmethod print-object ((self person) stream)
  (print-unreadable-object (self stream :type t)
    (with-slots (full-name gender) self
      (format stream "~A (~A)"
	      full-name gender))))

(defun make-person (first last gender &rest args)
  "Return a person with a given first and last name, and gender"
  (apply #'make-instance 'person
	 :first-name (cv first)
	 :last-name (cv last)
	 :gender (cv gender)
	 args))

(defparameter john (make-person "John" "Smith" 'male))

(def-c-echo full-name ((self person))
  (when old-value
    (format t "~&~A is now named ~A~%"
	    old-value new-value)))

(def-c-echo gender ((self person))
  (when old-value
    (format t "~&~A has undergone a sex change from ~A to ~A~%"
	    (full-name self) old-value new-value)))

(def-c-echo friends ((self person))
  (when old-value
    (let ((delta-friends (- (length new-value)
			    (length old-value))))
      (cond ((> delta-friends 0)
	     (format t "~A has acquired ~A new friends: ~S~%"
		     (full-name self)
		     delta-friends
		     (set-difference new-value old-value)))
	    ((< delta-friends 0)
	     (format t "~A has lost ~A friends: ~S~%"
		     (full-name self)
		     (* -1 delta-friends)
		     (set-difference old-value new-value)))))))

;; The database itself
;;;;;;;;;;;;;;;;;;;;;;

(defmodel table (family)
  ())

(defparameter *people* (to-be (make-instance 'table))
  "A database table of people")

(defun select-if (predicate table)
  (remove-if-not predicate (kids table)))

(defun select-if-not (predicate table)
  (remove-if predicate (kids table)))

(defun select-slot (slot-accessor value table &key (test #'equalp))
  (remove value (kids table)
	  :key slot-accessor :test test))

(defun select-slot-unique (slot-accessor value table &key (test #'equalp))
  (find value (kids table)
	:key slot-accessor :test test))

#+nil
(setf (kids *people*)
      (list (make-person "John" "Smith" 'male
			 :friends (c? (select-if #'female (fmparent self))))
	    (make-person "Mary" "Sperling" 'female)
	    (make-person "Jacob" "Demwa" 'male)
	    (make-person "Senora" "Cardgage" 'female)))

#+nil (push (make-person "Sally" "Reynolds" 'female) (kids *people*))

;(friends (select-slot-unique #'full-name "John Smith" *people*))

;; Higher-level person database
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun reset-people ()
  (cell-reset)
  (setf *people* (to-be (make-instance 'table))))

(define-symbol-macro people (fmparent self))

(defmacro defperson (first last gender &optional friends)
  `(push (make-person ,first ,last ,gender :friends ,friends)
         (kids *people*)))

(reset-people)
(defperson "John" "Smith" 'male
	   (c? (select-if #'female people)))
(defperson "Mary" "Sperling" 'female)
(defperson "Jacob" "Demwa" 'male)
(defperson "Senora" "Cardgage" 'female)
(defperson "The" "Huuuuuudge" 'male)

(setf (gender (select-slot-unique #'first-name "The" *people*)) 'female)